home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
TUGU10.ZIP
/
FRACTAL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-04-04
|
16KB
|
616 lines
{$N+,E+}
Program FractalExplorer;
Uses tugu,jmouse,crt;
Label Beginning;
Const
mandtype = 2; { what power? }
Type
unreal = extended;
Var
ftype : integer;
paltype : integer;
stdpal : palarray;
itterations : integer;
achar : char;
xorg,yorg,xlim,ylim,
newxo,newyo,newxl,newyl : unreal;
xstart,ystart : unreal; { used for julia set }
mousexo,mouseyo,mousexl,mouseyl,
oldmxl,oldmyl,oldmxo,oldmyo : word;
tempxo,tempyo : word;
i,j : integer;
a,b : word;
temp : byte;
stuff : string;
font : pointer;
waitfor0,waitfor1 : boolean;
rec : array [1..4,0..319] of byte;
backcolor : byte; { mouse variables }
curwidth, curheight : word;
{ cursorptr,}lcursor : pointer;
buttons : byte;
zoomout : array [0..10] of record
order : byte; { indicates # of zooms back }
ptr : pointer; { points to screen shot of picture }
x1,x2,y1,y2 : unreal; { coords for zoom window }
End;
zn : byte; { indicates which zoom is being used }
maxzooms : integer;
redrawfractal : boolean;
palnum : integer;
colnum : integer;
firstfractal : boolean;
pickjuliapoint : boolean;
fv : file;
Procedure SquareComplex(Var x,y,xp,yp : unreal); { xp,yp = current position }
{ in graph }
Var
{ (x + yi)^2 = x^2 - y^2 + 2xyi }
temp : unreal;
Begin
temp := x*x - y*y + xp;
y := 2 * x * y + yp;
x := temp;
End;
Procedure ThirdComplex(Var x,y,xp,yp : unreal);
Var
temp : unreal;
Begin
temp := x*x*x - 3*y*y*x + xp;
y := -y*y*y + 3*x*x*y + yp;
x := temp;
End;
Procedure ForthComplex(Var x,y,xp,yp : unreal); { xp,yp = current position }
{ on graph }
Var
{ (x + yi)^4 = x^4 + y^4 - 6(x^2)(y^2) + }
temp : unreal; { 4(x^3)(y)i - 4(x)(y^3)i }
Begin
temp := x*x*x*x + y*y*y*y - 6*x*x*y*y + xp;
y := 4*x*x*x*y - 4*x*y*y*y + yp;
x := temp;
End;
Procedure FifthComplex(Var x,y,xp,yp : unreal);
Var
temp : unreal;
Begin
temp := x*x*x*x*x - 10*x*x*x*y*y + 5*x*y*y*y*y + xp;
y := 5*x*x*x*x*y - 10*x*x*y*y*y + y*y*y*y*y + yp;
x := temp;
End;
Procedure SixthComplex(Var x,y,xp,yp : unreal);
Var
temp : unreal;
Begin
temp := (x*x*x*x*x*x) + (15*x*x*y*y*y*y) - (15*x*x*x*x*y*y) - (y*y*y*y*y*y) + xp;
y := (6*x*y*y*y*y*y) - (20*x*x*x*y*y*y) + (6*x*x*x*x*x*y) + yp;
x := temp;
End;
Procedure SeventhComplex(Var x,y,xp,yp : unreal);
Var
temp : unreal;
Begin
temp := x*x*x*x*x*x*x - 21*x*x*x*x*x*y*y + 35*x*x*x*y*y*y*y - 7*x*y*y*y*y*y*y + xp;
y := 7*x*x*x*x*x*x*y - 35*x*x*x*x*y*y*y + 21*x*x*y*y*y*y*y - y*y*y*y*y*y*y + yp;
x := temp;
End;
Procedure EighthComplex(Var x,y,xp,yp : unreal);
Var
temp : unreal;
Begin
temp := (x*x*x*x*x*x*x*x) - (28*x*x*x*x*x*x*y*y);
temp := temp + (70*x*x*x*x*y*y*y*y) - (28*y*y*y*y*y*y*x*x) + (y*y*y*y*y*y*y*y) + xp;
y := (8*x*x*x*x*x*x*x*y) - (56*x*x*x*x*x*y*y*y) + (56*x*x*x*y*y*y*y*y) - (8*x*y*y*y*y*y*y*y) + yp;
x := temp;
End;
Procedure DisplayMandelbrot(xorg,yorg,xlim,ylim : unreal; maxittr : word; ftype : integer);
Var
xstep,ystep : unreal; { distance between pixels }
xpos,ypos : unreal; { current pixel evaluation position }
done : boolean;
steps : word;
xiter,yiter : unreal; { itterated values of x,y }
temp : unreal;
Begin
xstep := (xlim-xorg)/320;
ystep := (ylim-yorg)/200;
ypos := yorg;
for i := 0 to ymax do
Begin
xpos := xorg;
for j := 0 to xmax do
Begin
color := 1;
putpix(j,i);
xiter := 0;
yiter := 0;
steps := 0;
done := false;
if ftype = 2 then
Begin
xiter := xpos;
yiter := ypos;
End;
Repeat
steps := steps + 1;
if ftype = 1 then
Begin
xstart := xpos;
ystart := ypos;
End;
Case mandtype of
2 : SquareComplex(xiter,yiter,xstart,ystart);
3 : ThirdComplex(xiter,yiter,xstart,ystart);
4 : ForthComplex(xiter,yiter,xstart,ystart);
5 : FifthComplex(xiter,yiter,xstart,ystart);
6 : SixthComplex(xiter,yiter,xstart,ystart);
7 : SeventhComplex(xiter,yiter,xstart,ystart);
8 : EighthComplex(xiter,yiter,xstart,ystart);
End;
if sqr(xiter)+sqr(yiter) >= 9 then done := true;
if steps > maxittr then done := true;
Until done;
steps := steps - 1;
color := steps mod 196;
if color = 0 then color := 196;
if steps < maxittr then putpix(j,i);
if steps >= maxittr then
Begin
color := 0;
putpix(j,i);
End;
xpos := xpos + xstep;
End;
ypos := ypos + ystep;
End;
End;
Procedure TwoColor(num,num2 : integer);
Var
bright,bright2 : integer;
Begin
num := num mod 12;
num2 := num2 mod 12;
if num < 6 then bright := 47 else bright := 63;
if num2 < 6 then bright2 := 47 else bright2 := 63;
num := num mod 6;
num2 := num2 mod 6;
pal[1,1] := bright*abs(((num-3) div 2));
pal[1,2] := bright*abs(abs(((num-2) div 2))-1);
pal[1,3] := bright*(num div 3);
pal[98,1] := bright2*abs(((num2-3) div 2));
pal[98,2] := bright2*abs(abs(((num2-2) div 2))-1);
pal[98,3] := bright2*(num2 div 3);
pal[196,1] := bright*abs(((num-3) div 2));
pal[196,2] := bright*abs(abs(((num-2) div 2))-1);
pal[196,3] := bright*(num div 3);
smoothblend(pal,1,98);
smoothblend(pal,98,196);
setrgbpal(pal);
End;
Procedure DarkRainbow(num : byte);
Begin
pal[1,(num mod 3)+1] := 63;
pal[1,((num+1) mod 3)+1] := 0;
pal[1,((num+2) mod 3)+1] := 0;
pal[64,(num mod 3)+1] := 0;
pal[64,((num+1) mod 3)+1] := 63;
pal[64,((num+2) mod 3)+1] := 0;
pal[128,(num mod 3)+1] := 0;
pal[128,((num+1) mod 3)+1] := 0;
pal[128,((num+2) mod 3)+1] := 63;
pal[196,(num mod 3)+1] := 63;
pal[196,((num+1) mod 3)+1] := 0;
pal[196,((num+2) mod 3)+1] := 0;
smoothblend(pal,1,64);
smoothblend(pal,64,128);
smoothblend(pal,128,196);
setrgbpal(pal);
End;
Procedure StandardPal;
Begin
SetRGBPal(stdpal);
End;
Begin
ChgMouseColor(cursorptr,197);
lcursor := NIL;
randomize;
paltype := 2;
writeln('# of itterations (0-1024) (386dx try 128, 486dx try 256)');
readln(itterations);
if keypressed then achar := readkey;
vgamode;
GetRGBPal(pal);
for i := 1 to 3 do
Begin
pal[0,i] := 0;
pal[197,i] := 63;
pal[213,i] := 0;
End;
smoothblend(pal,197,213);
stdpal := pal;
SetRGBPal(pal);
palnum := 0;
loadfont(font,'fractal.tf');
if paltype = 2 then { rainbow palette }
darkrainbow(1);
xorg := -1.6295234671;
xlim := -1.6295234666;
yorg := -0.0051268052382;
ylim := -0.0051268047045;
xorg := -0.74401626712;
xlim := -0.74401604109;
yorg := 0.14716055214;
ylim := 0.14716077093;
i := 0;
Repeat
getmem(zoomout[i].ptr,64000);
i := i + 1;
Until memavail < 70000;
maxzooms := i - 1;
beginning:
ftype := 1;
xorg := -2.2;
xlim := 2.2;
yorg := -1.5;
ylim := 1.5;
xstart := 0.4;
ystart :=-0.35;
clrbuf(0);
for i := 0 to maxzooms do
zoomout[i].order := maxzooms + 1; { indicates unused }
zoomout[0].order := 0;
zn := 0;
zoomout[0].x1 := xorg;
zoomout[0].x2 := xlim;
zoomout[0].y1 := yorg;
zoomout[0].y2 := ylim;
redrawfractal := true;
colnum := random(12);
assign(fv,'mandel.pcx');
{$I-}
reset(fv);
{$I+}
if (mandtype = 2) and (ioresult = 0) then
PCXLoad('mandel.pcx',pal,0,0)
else
DisplayMandelbrot(xorg,yorg,xlim,ylim,itterations,ftype);
firstfractal := true;
pickjuliapoint := false;
achar := #0;
Repeat
if not(firstfractal) then begin
if redrawfractal then DisplayMandelbrot(xorg,yorg,xlim,ylim,itterations,ftype)
else
BuftoScreen(zoomout[zn].ptr);
End;
firstfractal := false;
if pickjuliapoint then begin
Repeat
MouseStatus(i,j,buttons);
Until buttons mod 2 = 0;
repeat
MoveMouseA(cursorptr,buttons,0,lcursor);
MoveMouseb(cursorptr,buttons,0,lcursor);
Until buttons = 1;
xstart := (mousex/SW)*(zoomout[zn].x2-zoomout[zn].x1) + zoomout[zn].x1;
ystart := (mousey/SH)*(zoomout[zn].y2-zoomout[zn].y1) + zoomout[zn].y1;
firstfractal := false;
ftype := 2;
pickjuliapoint := false;
xorg := -2.2;
xlim := 2.2;
yorg := -1.5;
ylim := 1.5;
zoomout[0].x1 := xorg;
zoomout[0].x2 := xlim;
zoomout[0].y1 := yorg;
zoomout[0].y2 := ylim;
for i := 0 to maxzooms do begin
zoomout[i].order := maxzooms + 1; { indicates unused }
End;
zoomout[0].order := 0;
zn := 0;
DisplayMandelbrot(xorg,yorg,xlim,ylim,itterations,ftype);
resetmouse(cursorptr,lcursor);
End;
newxo := xorg;
newxl := xlim;
newyo := yorg;
newyl := ylim;
ScreentoBuf(zoomout[zn].ptr);
mousexo := 10000;
mousexl := 10000;
Repeat
backcolor := 0;
curwidth := 5;
curheight := 10;
MovemouseA(cursorptr,buttons,0,lcursor); { first movemouse }
if (waitfor1) and (buttons = 1) then { image processing & stuff }
Begin { | | | | | | | | | | | | }
waitfor0 := true; { V V V V V V V V V V V V }
waitfor1 := false;
newxo := xorg + (xlim-xorg)/320*mousex;
newyo := yorg + (ylim-yorg)/200*mousey;
oldmxo := mousexo;
oldmyo := mouseyo;
mousexo := mousex;
mouseyo := mousey;
End;
if (waitfor0) and (buttons = 0) then
Begin
waitfor0 := false;
waitfor1 := true;
newxl := xorg + (xlim-xorg)/320*mousex;
newyl := yorg + (ylim-yorg)/200*mousey;
End;
if (waitfor0) and (buttons = 1) and ((mousecx <> 0) or (mousecy <> 0)) then
Begin
if mousex <= mousexo then mousex := mousexo;
if mousey <= mouseyo then mousey := mouseyo;
oldmxl := mousexl;
oldmyl := mouseyl;
mousexl := mousex;
mouseyl := mousey;
if oldmxl <> 10000 then
Begin
if oldmxo <> 10000 then begin
tempxo := oldmxo;
tempyo := oldmyo;
End
else begin
tempxo := mousexo;
tempyo := mouseyo;
End;
for i := tempyo to oldmyl do begin
color := rec[1,i];
putpix(tempxo,i);
End;
for i := tempxo+1 to oldmxl-1 do begin
color := rec[2,i];
putpix(i,tempyo);
End;
if oldmyl > tempyo then
for i := tempyo to oldmyl do begin
color := rec[3,i];
putpix(oldmxl,i);
End;
if oldmxl > tempxo+2 then
for i := tempxo+1 to oldmxl-1 do begin
color := rec[4,i];
putpix(i,oldmyl);
End;
End;
oldmxo := mousexo;
oldmyo := mouseyo;
for i := mouseyo to mouseyl do
rec[1,i] := getpix(mousexo,i);
for i := mousexo+1 to mousexl-1 do
rec[2,i] := getpix(i,mouseyo);
if mouseyl > mouseyo then
for i := mouseyo to mouseyl do
rec[3,i] := getpix(mousexl,i);
if mousexl > mousexo+2 then
for i := mousexo+1 to mousexl-1 do
rec[4,i] := getpix(i,mouseyl);
color := 197;
End;
color := 197;
if (mousecx <> 0) or (mousecy <> 0) then
Begin
getimage(mousex,mousey,mousex+curwidth-1,mousey+curheight-1,lcursor);
if (waitfor0) and (buttons = 1) then
rectangle(mousexo,mouseyo,mousexl,mouseyl);
End;
MoveMouseB(cursorptr,buttons,0,lcursor); { Second Movemouse }
{ Easy isn't it! :) }
if keypressed then achar := readkey;
Until ((buttons = 2) or (ord(achar) = 27));
putimage(mousex,mousey,lcursor);
resetmouse(cursorptr,lcursor); { moved out a mouse loop, have to reset! }
color := 203;
rectanglefill(0,0,78,17);
rectanglefill(79,0,148,17);
rectanglefill(149,0,217,17);
rectanglefill(218,0,287,17);
rectanglefill(0,18,78,34);
rectanglefill(79,18,148,34);
color := 205;
rectanglefill(1,1,77,16);
rectanglefill(80,1,147,16);
rectanglefill(150,1,216,16);
rectanglefill(219,1,286,16);
rectanglefill(1,19,77,33);
rectanglefill(80,19,147,33);
color := 197;
stuff := 'ZOOM OUT';
curbuf := vidptr;
textxy(font,stuff,4,4,1);
stuff := 'ZOOM IN';
textxy(font,stuff,83,4,1);
stuff := 'RESTART';
textxy(font,stuff,153,4,1);
stuff := 'PAL CHG';
textxy(font,stuff,222,4,1);
stuff := 'PCX SAVE';
textxy(font,stuff,4,21,1);
stuff := 'JULIA';
textxy(font,stuff,92,21,1);
Repeat
MovemouseA(cursorptr,buttons,0,lcursor);
MovemouseB(cursorptr,buttons,0,lcursor);
if keypressed then achar := readkey;
Until ((buttons = 1) or (ord(achar) = 27));
resetmouse(cursorptr,lcursor);
redrawfractal := false;
if ((mousey < 17) and (buttons = 1)) then begin
if mousex < 79 then begin { ZOOM OUT }
temp := zn;
zn := maxzooms + 1;
for i := 0 to maxzooms do
if zoomout[i].order = 1 then zn := i;
if zn < (maxzooms+1) then
Begin
xorg := zoomout[zn].x1;
xlim := zoomout[zn].x2;
yorg := zoomout[zn].y1;
ylim := zoomout[zn].y2;
for i := 0 to maxzooms do
Begin
if zoomout[i].order <= maxzooms then
zoomout[i].order := zoomout[i].order - 1
else
zoomout[i].order := maxzooms + 1;
if zoomout[i].order = 0 then zn := i;
End;
End
else zn := temp;
End
else
if (mousex < 149) then { ZOOM IN }
Begin
xorg := newxo;
yorg := newyo;
xlim := newxl;
ylim := newyl;
zn := 0;
While zoomout[zn].order < maxzooms do
zn := zn + 1;
for i := 0 to maxzooms do
zoomout[i].order := zoomout[i].order + 1;
zoomout[zn].order := 0;
zoomout[zn].x1 := xorg;
zoomout[zn].x2 := xlim;
zoomout[zn].y1 := yorg;
zoomout[zn].y2 := ylim;
redrawfractal := true;
End
else
if mousex < 218 then goto beginning { RESTART }
else
if mousex < 288 then begin { CHANGE PAL }
Repeat
i := random(12);
Until i <> colnum;
if palnum < 4 then
Twocolor(colnum,i);
if palnum = 5 then
DarkRainbow(colnum mod 3);
if palnum = 4 then
StandardPal;
if (palnum > 5) and (palnum < 10) then
TwoColor(colnum,i);
if palnum = 10 then
DarkRainbow(colnum mod 3);
if palnum < 10 then
palnum := palnum + 1
else
palnum := 0;
colnum := (colnum + 1) mod 12;
redrawfractal := false;
End;
End { mousey < 17 }
else if ((mousey < 33) and (buttons = 1)) then begin
if mousex < 79 then begin { PCX SAVE }
curbuf := zoomout[zn].ptr;
PCXSave('fractal.pcx',pal,0,0,319,199);
curbuf := vidptr;
End
else if mousex < 149 then begin { JULIA }
if ftype = 1 then pickjuliapoint := true;
End;
End; { mousey < 33 }
if keypressed then achar := readkey;
Until ord(achar) = 27;
setmode(3);
End.